POINT Software Programming/PPROG1.ISO/pascal/swag/tsr.swg/0020_Screen Saver.pas

Pascal/Delphi Source File | 1994-01-27 | 6.8 KB | 207 lines

unit Scrnsavr;
{$F+}
(*************************************************************************)
(*                        Screen Saver                                   *)
(*                                                                       *)
(*  Written by Jay A. Key -- Oct 1993                                    *)
(*  Code may be modified and used freely.  Please mention my name        *)
(*  somewhere in your docs or in the program itself.                     *)
(*                                                                       *)
(*  Self contained unit to install a text-mode screen saver in Turbo     *)
(*  Pascal programs.  Simply include the following line in your code.    *)
(*    uses ScrnSavr;                                                     *)
(*                                                                       *)
(*  It will initialize itself automatically, and will remove itself      *)
(*  upon exit from your program, graceful exit or not.  Functions        *)
(*  SetTimeOut and SetDelay are included if you wish to modify the       *)
(*  default values.                                                      *)
(*                                                                       *)
(*  Warning: will not properly save and restore screens while running    *)
(*  under the Turbo Pascal IDE.  Runs great from DOS.                    *)
(*************************************************************************)

interface

uses
  Dos, Crt;

function  NumRows : byte;          {Returns number of rows in current screen}
function  ColorAdaptor : boolean;  {TRUE if color video card installed}
procedure SetTimeOut(T : integer); {Delay(seconds) before activation}
procedure SetDelay(T : integer);   {Interval between iterations}

implementation

type
  VideoArray = array [1..2000] of word;  {buffer to save video screen}

var
  Timer     : word;
  Waiting   : boolean;
  OldInt15,                  {Keyboard interrupt}
  OldInt1C,                  {Timer interrupt}
  OldInt23,                  {Cntl-C/Cntl-Break handler}
  ExitSave  : pointer;
  Position,
  Cursor    : integer; {save and restore cursor positions}
  VideoSave : VideoArray;
  VideoMem  : ^VideoArray;
  TimeOut,
  Delay     : integer;

procedure JumpToPriorIsr(p : pointer);
{Originally written by Brook Monroe, "An ISR Clock", pg. 64,
 PC Techniques Aug/Sep 1992}
inline($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/$ec/$5d/$07/$1f/
       $5f/$5e/$5a/$59/$cb);

function ColorAdaptor : boolean; assembler;
asm
  int 11                   {BIOS call - get equipment list}
  and al,$0010             {mask off all but bit 4}
  xor al,$0010             {flip bit 4 - return val is in al}
end;

function NumRows : byte; assembler;  {returns number of displayable rows}
asm
  mov ax,$40
  mov es,ax
  mov ax,$84
  mov di,ax
  mov al,[es:di]           {byte at [$40:$84] is number of rows in display}
end;

procedure HideCursor; assembler;
asm
  mov ah,$03
  xor bh,bh
  int $10               {video interrupt}
  mov Position,dx       {save cursor position}
  mov Cursor,cx         {and type}
  mov ah,$01
  mov ch,$20
  int $10               {video interrupt - hide cursor}
end;

procedure RestoreCursor; assembler;
asm
  mov ah,$02
  xor bh,bh
  mov dx,Position       {get old position}
  int $10               {video interrupt - restore cursor position}
  mov cx,Cursor         {get old cursor type}
  mov ah,$01
  int $10               {video interrupt - restore cursor type}
end;

procedure RestoreScreen;
begin
  VideoMem^ := VideoSave;  {Copy saved image back onto video memory}
  RestoreCursor;
end;

procedure SaveScreen;
begin
  VideoSave := VideoMem^;  {Copy video memory to array}
  HideCursor;
end;

procedure DispMsg;  {simple stub-out for displaying YOUR message(s),
                     pictures, etc...use your imagination!!!}
begin
  ClrScr;
  GotoXY(random(50), random(23));
  writeln('This would normally be something witty!');
end;

procedure NewInt15(Flags,CS,IP,AX,BX,CX,DX,
                   SI,DI,DS,ES,BP:WORD); interrupt; {keyboard handler}
begin
  Timer := 0;                     {Reset timer}
  if Waiting then                 {Screen saver activated?}
  begin
    RestoreScreen;                {Restore saved screen image}
    Waiting := FALSE;             {De-activate screen saver}
    Flags   := (Flags and $FFFE); {Tell BIOS to ignore current keystroke}
  end
  else
    JumpToPriorISR(OldInt15);   {call original int 15}
end;

procedure NewInt1C; interrupt;    {timer interrupt}
begin
  Inc(Timer);                 {Increment timer}
  if Timer > TimeOut then     {No key hit for TimeOut seconds?}
  begin
    Waiting := TRUE;          {Activate screen saver}
    SaveScreen;               {Save image of video memory}
    DispMsg;                  {Display your own message}
    Timer := 0;               {Reset timer}
  end;
  if waiting then             {Is saver already active?}
  begin
    if Timer > Delay then     {Time for next message?}
    begin
      Timer := 0;             {Reset timer}
      DispMsg;                {Display next message}
    end;
  end;
  JumpToPriorISR(OldInt1C);   {Chain to old timer interrupt}
end;

procedure ResetIntVectors;    {Restores Intrrupt vectors to orig. values}
begin
  SetIntVec($15, OldInt15);
  SetIntVec($1C, OldInt1C);
  SetIntVec($23, OldInt23);
end;

procedure NewInt23; interrupt;{Called to handle cntl-c/brk}
begin
  ResetIntVectors;            {Restore old interrupt vectors}
  JumpToPriorISR(OldInt23);   {Chain to original int 23h}
end;

procedure MyExit; far;        {exit code for unit}
begin
  ResetIntVectors;            {Restore old interrupt vectors}
  ExitProc := ExitSave;       {Restore old exit code}
end;

procedure SetVideoAddress;    {Returns pointer to text video memory}
begin
  if ColorAdaptor then
    VideoMem := ptr($B000, $0000)
  else
    VideoMem := ptr($B800, $0000);
end;

procedure SetTimeOut(T : integer); {Set delay(seconds) before activation}
begin
  TimeOut := Round(T * 18.2);
end;

procedure SetDelay(T : integer);  {Set interval between iterations}
begin
  Delay := Round(T * 18.2);
end;

{Initialize unit}
begin
  SetVideoAddress;             {Set up address for video memory}
  Waiting  := FALSE;            {Screen saver initially OFF}
  Timer    := 0;                  {Reset timer}
  ExitSave := ExitProc;        {Save old exit routine}
  ExitProc := @MyExit;         {Install own exit routine}
  {Install user defined int vectors}
  GetIntVec($15, OldInt15);     {Keyboard handler}
  SetIntVec($15, @NewInt15);
  GetIntVec($1c, OldInt1C);     {Timer int}
  SetIntVec($1c, @NewInt1C);
  GetIntVec($23, OldInt23);     {Cntl-C/Brk handler}
  SetIntVec($23, @NewInt23);
  SetTimeOut(120);
  SetDelay(15);
end.